﻿module BoardTool.InspectTerrains

open System
open System.Collections.Generic

open BoardTool.Board
open BoardTool.Tool
open BoardTool.DirTree
open BoardTool.Commands

type TerrainParamsRangesTable = Dictionary<string, (int * int)[]>

type FileSummary =
    {
    File : string
    TerrainParamsRanges : TerrainParamsRangesTable
    NegHexes : ResizeArray<int*string>
    GlobalTerrainTypes : HashSet<string>
    }

let private generalize (pte : Terrain) =
    match pte.Exits with
    | None -> pte.Type + ":_"
    | Some _ -> pte.Type + ":_:_"

let private getRanges (pte : Terrain) =
    match pte.Exits with
    | None -> [| pte.Level, pte.Level |]
    | Some ex -> [| pte.Level, pte.Level; ex, ex |]

let private mergeRanges a b =
    Array.map2 
        (fun (aLowI, aHighI) (bLowI, bHighI) ->
            let cLowI = min aLowI bLowI
            let cHighI = max aHighI bHighI
            cLowI, cHighI
        )
        a b

let private updateTerrainRanges (tprt : TerrainParamsRangesTable) ttype a =
    let hasType, b = tprt.TryGetValue( ttype )
    if hasType then 
        let c = mergeRanges a b
        tprt.[ttype] <- c
    else
        tprt.[ttype] <- a

let private mergeTerrainRanges (tprtA : TerrainParamsRangesTable) (tprtB : TerrainParamsRangesTable) =
    for ttype in tprtB.Keys do
        let rangesB = tprtB.[ttype]
        let hasKey, rangesA = tprtA.TryGetValue( ttype )
        if hasKey then
            let rangesC = mergeRanges rangesA rangesB
            tprtA.[ttype] <- rangesC
        else
            tprtA.[ttype] <- rangesB

let private inspectHex (fs : FileSummary) (hex : Hex) =
    for pte in hex.Terrains do
        let gType = generalize pte 
        let rr = getRanges pte
        updateTerrainRanges fs.TerrainParamsRanges gType rr
        if pte.Level < 0 then fs.NegHexes.Add( hex.Coords, gType )

type private InspectTerrainsCommand( dir ) =
    inherit MapDirCommand< FileSummary >( dir )

    override this.Id = 
        sprintf "(inspectdir %s)" dir

    override this.processFile file =
        
        let fs = 
            { 
            File = file
            TerrainParamsRanges = TerrainParamsRangesTable()
            NegHexes = ResizeArray()
            GlobalTerrainTypes = HashSet()
            }

        let entries = parseBoardFile file
        entries |> Array.iter (iterHex <| inspectHex fs)

        let firstHex = ref true
        entries |> Array.iter (iterHex 
            (fun hex ->
                if !firstHex then
                    firstHex := false
                    hex.Terrains 
                    |> Seq.map (fun t -> t.Type)
                    |> Seq.iter (fs.GlobalTerrainTypes.Add >> ignore)
                else
                    let terrains = HashSet(hex.Terrains |> Seq.map (fun t -> t.Type))
                    fs.GlobalTerrainTypes.IntersectWith( terrains )
            ))

        fs

    override this.reduce results =
        let terrainParamsRanges = TerrainParamsRangesTable()

        let filesWithNegHexes = ResizeArray()
        let filesWithGlobalTerrainTypes = ResizeArray()

        for fs in results.Values do
            mergeTerrainRanges terrainParamsRanges fs.TerrainParamsRanges
            if fs.NegHexes.Count > 0 then
                filesWithNegHexes.Add( (fs.File, fs.NegHexes) )
            if fs.GlobalTerrainTypes.Count > 0 then
                filesWithGlobalTerrainTypes.Add( (fs.File, fs.GlobalTerrainTypes) )
        
        printfn "Terrain types found:"
        
        let terrainTypes = terrainParamsRanges.Keys |> Array.ofSeq
        Array.sortInPlace terrainTypes

        let maxLength = terrainTypes |> Seq.map String.length |> Seq.max

        for ttype in terrainTypes do
            let rangesStr = 
                terrainParamsRanges.[ttype]
                |> Seq.map (fun (lowI, highI) -> sprintf "[%d...%d]" lowI highI)
                |> String.concat " : "
            let pttype = ttype.PadRight( maxLength )
            printfn "%s | %s" pttype rangesStr
                
        printfn ""
        if filesWithNegHexes.Count > 0 then
            printfn "Files with hexes with negative terrain levels: %d" filesWithNegHexes.Count
            for file, nh in filesWithNegHexes do
                printfn "  %s:\n    %s" file (nh |> Seq.map string |> String.concat " ")
        else
            printfn "Files with hexes with negative terrain levels: none"

        printfn ""
        if filesWithGlobalTerrainTypes.Count > 0 then
            printfn "Files with global terrain types: %d" filesWithGlobalTerrainTypes.Count
            for file, gtt in filesWithGlobalTerrainTypes do
                printfn "  %s: [ %s ]" file (gtt |> String.concat "; ")
        else
            printfn "Files with global terrain types: none"
        
let INSPECT_TERRAINS_COMMAND_FACTORY =
    { new MapDirCommandFactory( "inspect", "inspects terrain types and their parameters" ) with
        override this.createCommand( dir ) =
            InspectTerrainsCommand( dir ) :> ICommand
    } :> ICommandFactory
